home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form Calculator
- BorderStyle = 1 'Fixed Single
- Caption = "Calculator"
- ClientHeight = 2985
- ClientLeft = 1215
- ClientTop = 1695
- ClientWidth = 3240
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 3390
- Icon = NCALC.FRX:0000
- Left = 1155
- LinkMode = 1 'Source
- LinkTopic = "Form1"
- MaxButton = 0 'False
- ScaleHeight = 2985
- ScaleWidth = 3240
- Top = 1350
- Width = 3360
- Begin CommandButton Percent
- Caption = "%"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Left = 2640
- TabIndex = 17
- Top = 2400
- Width = 480
- End
- Begin CommandButton Operator
- Caption = "="
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 4
- Left = 2040
- TabIndex = 16
- Top = 2400
- Width = 480
- End
- Begin CommandButton Decimal
- Caption = "."
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Left = 1320
- TabIndex = 18
- Top = 2400
- Width = 480
- End
- Begin CommandButton Number
- Caption = "0"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 0
- Left = 120
- TabIndex = 0
- Top = 2400
- Width = 1080
- End
- Begin CommandButton Operator
- Caption = "/"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 0
- Left = 2640
- TabIndex = 15
- Top = 1800
- Width = 480
- End
- Begin CommandButton Operator
- Caption = "X"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 2
- Left = 2040
- TabIndex = 14
- Top = 1800
- Width = 480
- End
- Begin CommandButton Number
- Caption = "3"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 3
- Left = 1320
- TabIndex = 3
- Top = 1800
- Width = 480
- End
- Begin CommandButton Number
- Caption = "2"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 2
- Left = 720
- TabIndex = 2
- Top = 1800
- Width = 480
- End
- Begin CommandButton Number
- Caption = "1"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 1
- Left = 120
- TabIndex = 1
- Top = 1800
- Width = 480
- End
- Begin CommandButton Operator
- Caption = "-"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 3
- Left = 2640
- TabIndex = 13
- Top = 1200
- Width = 480
- End
- Begin CommandButton Operator
- Caption = "+"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 1
- Left = 2040
- TabIndex = 12
- Top = 1200
- Width = 480
- End
- Begin CommandButton Number
- Caption = "6"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 6
- Left = 1320
- TabIndex = 6
- Top = 1200
- Width = 480
- End
- Begin CommandButton Number
- Caption = "5"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 5
- Left = 720
- TabIndex = 5
- Top = 1200
- Width = 480
- End
- Begin CommandButton Number
- Caption = "4"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 4
- Left = 120
- TabIndex = 4
- Top = 1200
- Width = 480
- End
- Begin CommandButton CancelEntry
- Caption = "CE"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Left = 2640
- TabIndex = 11
- Top = 600
- Width = 480
- End
- Begin CommandButton Cancel
- Caption = "C"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Left = 2040
- TabIndex = 10
- Top = 600
- Width = 480
- End
- Begin CommandButton Number
- Caption = "9"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 9
- Left = 1320
- TabIndex = 9
- Top = 600
- Width = 480
- End
- Begin CommandButton Number
- Caption = "8"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 8
- Left = 720
- TabIndex = 8
- Top = 600
- Width = 480
- End
- Begin CommandButton Number
- Caption = "7"
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "System"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- Height = 480
- Index = 7
- Left = 120
- TabIndex = 7
- Top = 600
- Width = 480
- End
- Begin Label Readout
- Alignment = 1 'Right Justify
- BackColor = &H0000FFFF&
- BorderStyle = 1 'Fixed Single
- Caption = "0."
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "MS Sans Serif"
- FontSize = 13.5
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- ForeColor = &H00000000&
- Height = 375
- Left = 120
- TabIndex = 19
- Top = 105
- Width = 3000
- End
- ' ------------------------------------------------------------------------
- ' Copyright (C) 1991 Microsoft Corporation
- ' You have a royalty-free right to use, modify, reproduce and distribute
- ' the Sample Application Files (and/or any modified version) in any way
- ' you find useful, provided that you agree that Microsoft has no warranty,
- ' obligations or liability for any Sample Application Files.
- ' ------------------------------------------------------------------------
- ' Modifications & Enhancements by Marcus Smaby - these modifications
- ' & enhancements released to the public domain
- Dim Op1 As Double ' Previously input operand.
- Dim Op2 As Double ' Second operand.
- Dim DecimalFlag As Integer ' Decimal point present yet?
- Dim NumOps As Integer ' Number of operands.
- Dim LastInput As String ' Indicate type of last keypress.
- Dim OpFlag As String ' Indicate pending operation.
- Dim hWd As Integer ' Handle to Control
- Dim GoodKey As Integer ' Was this a key we can process
- Dim KeyState As String ' Remember state of Key to prevent repeat
- Dim LastKey As Integer ' scan code of last key
- Const True = -1
- Const FALSE = 0
- ' Click event procedure for C (cancel) key.
- ' Reset the display and initializes variables.
- Sub Cancel_Click ()
- Readout.Caption = "0."
- Form_Load
- End Sub
- Sub Cancel_KeyDown (KeyCode As Integer, Shift As Integer)
- LastKey = KeyCode
- ProcessKeyDown
- End Sub
- Sub Cancel_KeyUp (KeyCode As Integer, Shift As Integer)
- ProcessKeyUp
- End Sub
- ' Click event procedure for CE (cancel entry) key.
- Sub CancelEntry_Click ()
- Readout.Caption = "0."
- DecimalFlag = False
- LastInput = "CE"
- End Sub
- Sub CancelEntry_KeyDown (KeyCode As Integer, Shift As Integer)
- LastKey = KeyCode
- ProcessKeyDown
- End Sub
- Sub CancelEntry_KeyUp (KeyCode As Integer, Shift As Integer)
- ProcessKeyUp
- End Sub
- ' Click event procedure for decimal point (.) key.
- ' If last keypress was an operator, initialize
- ' readout to "0." Otherwise, append a decimal
- ' point to the display.
- Sub Decimal_Click ()
- If LastInput <> "NUMS" Then
- Readout.Caption = "0."
- ElseIf DecimalFlag = False Then
- Readout.Caption = Readout.Caption + "."
- End If
- DecimalFlag = True
- LastInput = "NUMS"
- End Sub
- Sub Decimal_KeyDown (KeyCode As Integer, Shift As Integer)
- LastKey = KeyCode
- ProcessKeyDown
- End Sub
- Sub Decimal_KeyUp (KeyCode As Integer, Shift As Integer)
- ProcessKeyUp
- End Sub
- ' Initialization routine for the form.
- ' Set all variables to initial values.
- Sub Form_Load ()
- DecimalFlag = False
- NumOps = 0
- LastInput = "NONE"
- OpFlag = " "
- End Sub
- ' Click event procedure for number keys (0-9).
- ' Appends new number to the number in the display.
- Sub Number_Click (Index As Integer)
- If LastInput <> "NUMS" Then
- Readout.Caption = ""
- DecimalFlag = False
- End If
- Readout.Caption = Readout.Caption + Number(Index).Caption
- LastInput = "NUMS"
- End Sub
- Sub Number_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer)
- LastKey = KeyCode
- ProcessKeyDown
- End Sub
- Sub Number_KeyUp (Index As Integer, KeyCode As Integer, Shift As Integer)
- ProcessKeyUp
- End Sub
- ' Click event procedure for operator keys (+, -, x, /, =).
- ' If the immediately preceeding keypress was part of a
- ' number, increment NumOps. If one operand is present,
- ' set Op1. If two are present, set Op1 equal to the
- ' result of the operation on Op1 and the current
- ' input string, and display the result.
- Sub Operator_Click (Index As Integer)
- If LastInput = "NUMS" Then
- NumOps = NumOps + 1
- End If
- If NumOps = 1 Then
- Op1 = Val(Readout.Caption)
- ElseIf NumOps = 2 Then
- Op2 = Val(Readout.Caption)
- Select Case OpFlag
- Case "+"
- Op1 = Op1 + Op2
- Case "-"
- Op1 = Op1 - Op2
- Case "X"
- Op1 = Op1 * Op2
- Case "/"
- If Op2 = 0 Then
- MsgBox "Can't divide by zero", 48, "Calculator"
- Else
- Op1 = Op1 / Op2
- End If
- Case "="
- Op1 = Op2
- End Select
- Readout.Caption = Format$(Op1)
- NumOps = 1
- End If
- LastInput = "OPS"
- OpFlag = Operator(Index).Caption
- End Sub
- Sub Operator_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer)
- LastKey = KeyCode
- ProcessKeyDown
- End Sub
- Sub Operator_KeyUp (Index As Integer, KeyCode As Integer, Shift As Integer)
- ProcessKeyUp
- End Sub
- ' Click event procedure for percent key (%).
- ' Compute and display a percentage of the first operand.
- Sub Percent_Click ()
- Readout.Caption = Format$(Op1 * Val(Readout.Caption) / 100)
- End Sub
- Sub Percent_KeyDown (KeyCode As Integer, Shift As Integer)
- LastKey = KeyCode
- ProcessKeyDown
- End Sub
- Sub Percent_KeyUp (KeyCode As Integer, Shift As Integer)
- ProcessKeyUp
- End Sub
- ' Key Table
- ' + = 43, - = 45, / = 47 * = 42
- ' % = 37, = = 61, c = 99,67, . = 46
- Sub ProcessKeyDown ()
- If KeyState = "DOWN" Then Exit Sub ' Avoid Auto Repeat
- ' classify keystroke & act
- ' Debug.Print lastkey
- Select Case LastKey
- Case 48 To 57 ' 0 - 9
- Number(LastKey - 48).SetFocus
- Number_Click (LastKey - 48)
- GoodKey = True
- Case KEY_NUMPAD0 To KEY_NUMPAD9
- Number(LastKey - KEY_NUMPAD0).SetFocus
- Number_Click (LastKey - KEY_NUMPAD0)
- GoodKey = True
- Case 187 ' =
- Operator(4).SetFocus
- Operator_Click (4)
- GoodKey = True
- Case KEY_SUBTRACT, 45 ' -
- Operator(3).SetFocus
- Operator_Click (3)
- GoodKey = True
- Case KEY_MULTIPLY, 42 ' *
- Operator(2).SetFocus
- Operator_Click (2)
- GoodKey = True
- Case KEY_DIVIDE, 47 ' /
- Operator(0).SetFocus
- Operator_Click (0)
- GoodKey = True
- Case KEY_ADD, 43 ' +
- Operator(1).SetFocus
- Operator_Click (1)
- GoodKey = True
- Case KEY_DECIMAL, 46 ' .
- Decimal.SetFocus
- Decimal_Click
- GoodKey = True
- Case 80, 112 ' p for percent
- Percent.SetFocus
- Percent_Click
- GoodKey = True
- Case 67, 99 ' C for Cancel
- Cancel.SetFocus
- Cancel_Click
- GoodKey = True
- Case 8, 127 ' <- or del for CancelEntry
- CancelEntry.SetFocus
- CancelEntry_Click
- GoodKey = True
- End Select
- If GoodKey Then
- hWd = getfocus() 'Get the Handle
- x = sendmessage(hWd, BM_SETSTATE, 1, 0) ' Set control as pressed
- End If
- KeyState = "DOWN"
- End Sub
- Sub ProcessKeyUp ()
- x = sendmessage(hWd, BM_SETSTATE, 0, 0) ' set control as unpressed
- KeyState = "UP"
- Operator(4).SetFocus ' Set Focus to Equals Key
- End Sub
-